home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / Gimp / Feature.pm < prev    next >
Encoding:
Perl POD Document  |  2003-01-14  |  6.0 KB  |  247 lines
  1. package Gimp::Feature;
  2.  
  3. require Exporter;
  4.  
  5. @ISA=(Exporter);
  6. @EXPORT = ();
  7.  
  8. my $gtk;
  9.  
  10. sub _check_gtk {
  11.    unless (defined $gtk) {
  12.       eval { require Gtk }; $gtk = $@ eq "" && $Gtk::VERSION>=0.5;
  13.    }
  14.    $gtk;
  15.  
  16. }
  17.  
  18. my %description = (
  19.    'gtk'        => 'the gtk perl module',
  20.    'gtk-1.1'    => 'gtk+ version 1.1 or higher',
  21.    'gtk-1.2'    => 'gtk+ version 1.2 or higher',
  22.    'gtk-1.3'    => 'gtk+ version 1.3 or higher',
  23.    'gtk-1.4'    => 'gtk+ version 1.4 or higher',
  24.  
  25.    'gimp-1.1'   => 'gimp version 1.1 or higher',
  26.    'gimp-1.2'   => 'gimp version 1.2 or higher',
  27.    'gimp-1.3'   => 'gimp version 1.3 or higher',
  28.  
  29.    'perl-5.005' => 'perl version 5.005 or higher',
  30.    'pdl'        => 'compiled-in PDL support',
  31.    'gnome'      => 'the gnome perl module',
  32.    'gtkxmhtml'  => 'the Gtk::XmHTML module',
  33.    'dumper'     => 'the Data::Dumper module',
  34.    'never'      => '(for testing, will never be present)',
  35.    'unix'    => 'a unix-like operating system',
  36.    'persistency'=> 'Gimp::Data can handle persistency',
  37. );
  38.  
  39. sub import {
  40.    my $pkg = shift;
  41.    my $feature;
  42.  
  43.    local $Gimp::in_query=(@ARGV and $ARGV[0] eq "-gimp");
  44.    while(defined (my $feature = shift)) {
  45.       $feature=~s/^://;
  46.       need($feature);
  47.    }
  48. }
  49.  
  50. sub describe {
  51.    $description{$_[0]};
  52. }
  53.  
  54. sub Gimp::Feature::list {
  55.    keys %description;
  56. }
  57.  
  58. sub present {
  59.    local $_ = shift;
  60.  
  61.    if ($_ eq "gtk") {
  62.       _check_gtk;
  63.    } elsif ($_ eq "gtk-1.1") {
  64.       _check_gtk and (Gtk->major_version==1 && Gtk->minor_version>=1) || Gtk->major_version>1;
  65.    } elsif ($_ eq "gtk-1.2") {
  66.       _check_gtk and (Gtk->major_version==1 && Gtk->minor_version>=2) || Gtk->major_version>1;
  67.    } elsif ($_ eq "gtk-1.3") {
  68.       _check_gtk and (Gtk->major_version==1 && Gtk->minor_version>=3) || Gtk->major_version>1;
  69.    } elsif ($_ eq "gtk-1.4") {
  70.       _check_gtk and (Gtk->major_version==1 && Gtk->minor_version>=4) || Gtk->major_version>1;
  71.  
  72.    } elsif ($_ eq "gimp-1.1") {
  73.       (Gimp->major_version==1 && Gimp->minor_version>=1) || Gimp->major_version>1;
  74.    } elsif ($_ eq "gimp-1.2") {
  75.       (Gimp->major_version==1 && Gimp->minor_version>=2) || Gimp->major_version>1;
  76.    } elsif ($_ eq "gimp-1.3") {
  77.       (Gimp->major_version==1 && Gimp->minor_version>=3) || Gimp->major_version>1;
  78.  
  79.    } elsif ($_ eq "perl-5.005") {
  80.       $] >= 5.005;
  81.    } elsif ($_ eq "pdl") {
  82.       require Gimp::Config; $Gimp::Config{DEFINE1} =~ /HAVE_PDL/;
  83.    } elsif ($_ eq "gnome") {
  84.       eval { require Gnome }; $@ eq "";
  85.    } elsif ($_ eq "gtkxmhtml") {
  86.       eval { require Gtk::XmHTML }; $@ eq "";
  87.    } elsif ($_ eq "dumper") {
  88.       eval { require Data::Dumper }; $@ eq "";
  89.    } elsif ($_ eq "persistency") {
  90.       eval { require Data::Dumper }; $@ eq "";
  91.    } elsif ($_ eq "unix") {
  92.       !{
  93.          MacOS        => 1,
  94.          MSWin32    => 1,
  95.          dos        => 1,
  96.          MSDOS        => 1,
  97.          os2        => 1,
  98.          VMS        => 1,
  99.          RISCOS        => 1,
  100.          AmigaOS    => 1,
  101.          utwin        => 1,
  102.        }->{$^O};
  103.    } elsif ($_ eq "never") {
  104.       0;
  105.    } else {
  106.       require Gimp;
  107.       Gimp::logger(message => "unimplemented requirement '$_' (failed)");
  108.       0;
  109.    }
  110. }
  111.  
  112. sub _missing {
  113.    my ($msg,$function)=@_;
  114.    require Gimp;
  115.    Gimp::logger(message => "$_[0] is required but not found", function => $function);
  116.    Gimp::initialized() ? Gimp::quiet_die() : Gimp::xs_exit(Gimp::quiet_main());
  117. }
  118.  
  119. sub missing {
  120.    local $Gimp::in_query=1;
  121.    &_missing;
  122. }
  123.  
  124. sub need {
  125.    my ($feature,$function)=@_;
  126.    _missing($description{$feature},$function) unless present $feature;
  127. }
  128.  
  129. 1;
  130. __END__
  131.  
  132. =head1 NAME
  133.  
  134. Gimp::Feature - check for specific features to be present before registering the script.
  135.  
  136. =head1 SYNOPSIS
  137.  
  138.   use Gimp::Feature;
  139.  
  140. or
  141.  
  142.   use Gimp::Feature qw(feature1 feature2 ...);
  143.  
  144. =head1 DESCRIPTION
  145.  
  146. This module can be used to check for specific features to be present. This
  147. can be used to deny running the script when neccessary features are not
  148. present. While some features can be checked for at any time, the Gimp::Fu
  149. module offers a nicer way to check for them.
  150.  
  151. =over 4
  152.  
  153. =item C<gtk>
  154.  
  155. checks for the presence of the gtk interface module.
  156.  
  157. =item C<gtk-1.1>, C<gtk-1.2>
  158.  
  159. checks for the presence of gtk-1.1 (1.2) or higher.
  160.  
  161. =item C<perl-5.005>
  162.  
  163. checks for perl version 5.005 or higher.
  164.  
  165. =item C<pdl>
  166.  
  167. checks for the presence of a suitable version of PDL (>=1.9906).
  168.  
  169. =item C<gnome>
  170.  
  171. checks for the presence of the Gnome-Perl module.
  172.  
  173. =item C<gtkxmhtl>
  174.  
  175. checks for the presence of the Gtk::XmHTML module.
  176.  
  177. =item C<unix>
  178.  
  179. checks wether the script runs on a unix-like operating system. At the
  180. moment, this is every system except windows, macos, os2 and vms.
  181.  
  182. =item C<persistency>
  183.  
  184. checks wether the C<Gimp::Data> module (L<Gimp::Data>) can handle complex
  185. persistent data structures, i.e. perl references in addition to plain
  186. strings.
  187.  
  188. =back
  189.  
  190. The following features can only be checked B<after> C<Gimp->main> has been
  191. called (usually found in the form C<exit main>). See L<Gimp::Fu> on how to
  192. check for these.
  193.  
  194. =over 4
  195.  
  196. =item C<gimp-1.1>, C<gimp-1.2>
  197.  
  198. checks for the presense of gimp in at least version 1.1 (1.2).
  199.  
  200. =back
  201.  
  202. =head2 FUNCTIONS
  203.  
  204. =over 4
  205.  
  206. =item present(feature)
  207.  
  208. Checks for the presense of the single feature given as the
  209. argument. Returns true if the feature is present, false otherwise.
  210.  
  211. =item need(feature,[function-name])
  212.  
  213. Require a specific feature. If the required feature is not present the
  214. program will exit gracefully, logging an appropriate message. You can
  215. optionally supply a function name to further specify the place where this
  216. feature was missing.
  217.  
  218. This is the function used when importing symbols from the module.
  219.  
  220. =item missing(feature-description,[function-name])
  221.    
  222. Indicates that a generic feature (described by the first argument) is
  223. missing. A function name can further be specified. This function will log
  224. the given message and exit gracefully.
  225.  
  226. =item describe(feature)
  227.  
  228. Returns a string describing the given feature in more detail, or undef if
  229. there is no description for this feature.
  230.  
  231. =item list()
  232.  
  233. Returns a list of features that can be checked for. This list might not be
  234. complete.
  235.  
  236. =back
  237.  
  238. =head1 AUTHOR
  239.  
  240. Marc Lehmann <pcg@goof.com>
  241.  
  242. =head1 SEE ALSO
  243.  
  244. perl(1), Gimp(1).
  245.  
  246. =cut
  247.